home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / oasis / oasisegs.lha / egs / quick.lisp < prev    next >
Lisp/Scheme  |  1992-04-23  |  1KB  |  38 lines
  1. (proclaim '(function quick     () list))
  2. (proclaim '(function sort      (list list) list))
  3. (proclaim '(function partition (list fixnum) list))
  4.  
  5. (defun run (m)
  6.        (declare (type fixnum m))
  7.        (do ((j 0 (+ j 1)))
  8.            ((= j m))
  9.            (declare (type fixnum j))
  10.            (quick) ))
  11.  
  12. (defun quick () (sort '(27 74 17 33 94 18 46 83 65  2
  13.                         32 53 28 85 99 47 28 82  6 11
  14.                         55 29 39 81 90 37 10  0 66 51
  15.                          7 21 85 27 31 63 75  4 95 99
  16.                         11 28 61 74 18 92 40 53 59  8) nil))
  17.  
  18. (defun sort (unsorted temp)
  19.        (declare (type list unsorted)
  20.                 (type list temp))
  21.        (if (null unsorted) temp
  22.            (let* ((x (car unsorted))
  23.                   (pair (partition (cdr unsorted) x)) )
  24.                  (declare (type fixnum x)
  25.                           (type list pair) )
  26.                  (sort (car pair) (cons x (sort (cdr pair) temp))) )))
  27.  
  28. (defun partition (nums x)
  29.        (declare (type list nums)
  30.                 (type fixnum x))
  31.        (if (null nums) '(nil . nil)
  32.            (let ((y (car nums))
  33.                  (pair (partition (cdr nums) x)) )
  34.                 (declare (type fixnum y)
  35.                          (type list pair) )
  36.                 (cond ((<= y x) (cons (cons y (car pair)) (cdr pair)))
  37.                       ((>  y x) (cons (car pair) (cons y (cdr pair)))) ))))
  38.